home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir30 / dt100.zip / MAKEBDR.LSP < prev    next >
Lisp/Scheme  |  1993-10-03  |  4KB  |  136 lines
  1. ; DrafTools   [Version 1.00] 9/25/93       
  2. ;
  3. ; ***************************************
  4. ; ****  Author:  Owen Wengerd        ****
  5. ; ****                               ****
  6. ; ****  Manu-Soft Computer Services  ****
  7. ; ****  P.O. Box 84                  ****
  8. ; ****  Fredericksburg, OH  44627    ****
  9. ; ****  (216) 695-5903               ****
  10. ; ****  Compu-Serve ID:  71324,3252  ****
  11. ; ***************************************
  12.  
  13.  
  14. (defun C:MAKEBDR (/ tmp errexit makebdrx fpath 
  15.                   dlg_retcode dcl_id xdos_loaded)
  16.  
  17. ' *** Local Functions ***
  18.  
  19. (defun errexit (s)
  20.   (princ "\nError:  ")
  21.   (princ s)
  22.   (restore)
  23. )
  24.  
  25. (defun makebdrx ()
  26.   (if (tblsearch "VIEW" "TEMP")
  27.     (command "_VIEW" "_R" "TEMP" "_VIEW" "_D" "TEMP" "_UCS" "_P")
  28.   )
  29.   (setvar "CMDECHO" oldvar)
  30.   (or
  31.     (not xdos_loaded)
  32.     (= T xdos_loaded)
  33.     (xunload "xdos_dt" nil)
  34.     (princ "\n**Cannot unload XDOS_DT from memory**\n ")
  35.   )
  36.   (setq *error* olderr)
  37.   (princ)
  38. )
  39.  
  40. (defun fpath (filename / path)
  41.   (if 
  42.     (and
  43.       *DT_PATH 
  44.       (setq path
  45.         (findfile 
  46.           (strcat 
  47.             *DT_PATH 
  48.             (if (= "\\" (substr *DT_PATH (strlen *DT_PATH) 1)) "" "\\")  
  49.             filename
  50.           )
  51.         )
  52.       )
  53.     )
  54.     path
  55.     (findfile filename)
  56.   )
  57. )
  58.  
  59.  
  60. ;***********************************************
  61. ;***************  Main Program  ****************
  62. ;***********************************************
  63.  
  64.   (setq T (not nil))
  65.   (setq olderr  *error*
  66.         restore makebdrx
  67.         *error* errexit
  68.   )
  69.   (setq oldvar (getvar "CMDECHO"))
  70.   (setvar "CMDECHO" 0)
  71.   (terpri)
  72.   (if 
  73.     (and
  74.       (or 
  75.         (setq xdos_loaded (= 'EXSUBR (type dt_dosdir))) 
  76.         (setq xdos_loaded (if (setq tmp (fpath "xdos_dt.exp")) (xload tmp nil)))
  77.       )
  78.       (setq dcl_id (if (setq tmp (fpath "MAKEBDR.DCL")) (load_dialog tmp)))
  79.     )
  80.     (progn
  81.       (command "_VIEW" "_S" "TEMP" "_UCS" "")
  82.       (setq dlg_retcode 6)
  83.       (while (and (> dlg_retcode 1) (new_dialog "MAKEBDR" dcl_id))
  84.         (setq dlg_retcode (start_dialog))
  85.         (cond
  86.           ( (= 2 dlg_retcode)
  87.             (if (setq tmp (getpoint "\n \nPick Insertion Point: "))
  88.               (command "_MOVE" "_ALL" "" tmp '(0 0 0) "_ZOOM" "_E")
  89.             )
  90.           )  
  91.           ( (= 3 dlg_retcode)
  92.             (if C:RE-ORDER
  93.               (C:RE-ORDER)
  94.               (if 
  95.                 (and
  96.                   (setq tmp (fpath "RE-ORDER.LSP"))
  97.                   (load tmp)
  98.                 )
  99.                 (C:RE-ORDER)
  100.                 (alert 
  101.                   (strcat "Cannot find file 'RE-ORDER.LSP'"
  102.                           "\n   in current search path!"
  103.                   )
  104.                 )
  105.               )
  106.             )
  107.           )
  108.           ( (= 1 dlg_retcode)
  109.             (if
  110.               (setq tmp 
  111.                 (getfiled "Enter Border Name" (getvar "DWGNAME") "BDR" 3)
  112.               )
  113.               (progn
  114.                 (dt_dosdeletefile "TEMPBDR.DWG")
  115.                 (command "WBLOCK" "TEMPBDR" "*")
  116.                 (dt_dosdeletefile tmp)
  117.                 (dt_dosrename "TEMPBDR.DWG" tmp)
  118.               )
  119.             )
  120.           )
  121.         )
  122.       )
  123.     )
  124.     (alert 
  125.       (if xdos_loaded
  126.         (strcat 
  127.           "Dialog Box Definition File 'INSTITLE.DCL' not Found"
  128.           "\n                Cannot Continue!"
  129.         )
  130.         "ADS Application 'XDOS_DT.EXP' not Found\n          Cannot Continue!"
  131.       )
  132.     )
  133.   )
  134.   (restore)
  135. )
  136.